perm filename CONVRT.FAI[GEM,HE] blob sn#058578 filedate 1973-08-27 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE CONVRT
C00006 00003	Subroutines RDINT,WRINT
C00008 00004	Subroutines RDSIX,WRSIX
C00010 00005	Subroutines WREFLO,WRFFLO,WRFLO
C00020 00006	Subroutines RDFILE,WRFILE
C00027 ENDMK
C⊗;
	TITLE CONVRT

COMMENT ⊗

This  package   is  a  collection   of  frequently   used  conversion
subroutines, such as  convert integer to character stream and convert
character  stream  to  sixbit.    The  character  stream   source  or
destination  are   defined  by  a   PDP-10  instruction,     such  as
PUSHJ_P,GETCHR.   All  character stream destinations  are expected to
return  a  character  in  accumulator  1  and  all  character  stream
destination are  expected to recieve its character  in accumulator 1.
Subroutines which return arguments  always return their arguments  in
accumulator 1 and  if a break character is  to be return, it  will be
in   accumulator  0.  Character  streams   should  modify  any  other
accumulators. These subroutines are:


RDINT(Integer BASE; Character_source OPCODE);
   Convert character stream into integer, in specified base.

WRINT(Integer N, BASE; Character_destination OPCODE);
   Convert integer into character stream, in specified base.

RDSIX(Integer SIXBIT; Character_source OPCODE, Breaktable BRKTAB);
   Convert sixbit word into character stream.

WRSIX(Integer SIXBIT; Character_destination OPCODE);
   Convert sixbit word into character stream.

RDFLO(Operation OPCODE);
   Convert character stream into real, in specified base. (UNIMPLIMENTED)

WREFLO(Real N,CHARACTER_COUNT,DECIMAL_COUNT; Character_destination
	 OPCODE);
   Convert floating point number into character stream of specified
format.  (See FORTRAN for details.)

RDFILE(Array FILBLK; Character_source OPCODE; Sixbit
	DEFAULT_EXTENSION)
   Convert a character string into system file name structure.

WRFILE(Array FILBLK; Character_destination OPCODE)
   Convert system file name structure into a character string.


A  break  table  is  the  standard  system  format  four  word  table
representing which  characters are break characters.   See UUO Manual
for details.  Briefly,

	Word 0 contains bits for <null> thru #,
	Word 1 contains bits for $ thru G,
	Word 2 contains bits for H thru k
	Word 3 contains bits for l thru <bs>
⊗;

IFNDEF STANSW,<↓STANSW←←1>
;Subroutines RDINT,WRINT
;____________________________________________________________________
SUBR RDINT,BASE,OPCODE
	SETZ 0,
LOOP:	XCT OPCODE
	CAIL 1,"0"
	CAILE 1,"9"
	GO [ EXCH 0,1
	     POP2J ]
	IMUL 0,BASE
	ADDI 0,-60(1)
	GO LOOP
ENDR RDINT
;____________________________________________________________________
SUBR WRINT,INTEGER,BASE,OPCODE
;  Convert integer into character stream, in specified base.
	MOVE 1,INTEGER↔POPP -2(P)	;FETCH ARG AND MOVE RET. ADR.
	POPP SAVBAS
	PUSHP 2
L1:	JUMPGE 1,L2			;TEST FOR NEGATIVE NUMBER.
	MOVM 2,1			;PRINT MINUS SIGN.
	MOVEI 1,"-"
	XCT OPCODE
	MOVE 1,2
	PUSH P,[RET]
L2:	IDIV 1,SAVBAS↔PUSH P,2		;MODULO TEN AND SAVE.
	SKIPE 1↔PUSHJ P,L2		;TEST FOR DONE.
	POP P,1↔ADDI 1,60
	XCT OPCODE			;RESTORE & PRINT.
	POP0J
RET:	POPP 2
	POP3J
	DECLARE{SAVBAS}
ENDR WRINT
;Subroutines RDSIX,WRSIX
;____________________________________________________________________
SUBR RDSIX,OPCODE,BRKTAB
; Read SIXBIT, where BRKTAB is address of 4 word bit table indicating what
;    characters are terminators.
; If there are more than 6 characters, additional characters are ignored.
;
; Returns SIXBIT in 1
;   Terminating character in 0.
	ACCUMULATOR{T1,P1}
	PUSHP T1		;Save AC's we'll need
	PUSHP P1
	MOVSI P1,(<POINT 6,0>)	;Pointer to where SIXBIT will go
	SETZ 0,
LOOP:	XCT OPCODE		;Pick up a character
	PUSHP 1
	IDIVI 1,=36
	ADD 1,BRKTAB
	MOVE 1,(1)
	LSH 1,(2)
	JUMPL 1,RET		;1 means terminator
	POP P,1
	CAIGE 1,"a"
	SUBI 1,40
	CAME P1,[POINT 6,0,35]	;Check for more than 6 characters
	IDPB 1,P1		;Pack into word
	GO LOOP
RET:	MOVE 1,0		;Get SIXBIT to return
	POPP 0			;Get back terminator
	POPP P1			;Restore saved AC's
	POPP T1
	POP2J
ENDR RDSIX
;____________________________________________________________________
SUBR WRSIX,SIX,OPCODE
;  Convert sixbit word into character stream.
	MOVEI 0,6
	PUSHP SIXPTR
LOOP:	ILDB 1,(P)
	ADDI 1,40
	XCT OPCODE
	SOJG 0,LOOP
	POPP 0
	POP2J
SIXPTR:	POINT 6,-1+SIX
ENDR WRSIX
;Subroutines WREFLO,WRFFLO,WRFLO
;____________________________________________________________________
SUBR WREFLO,NUMBER,CONTRL,OPERATION
	ACCUMULATORS{DECPT,DECEXP,CHRCNT}
;DECPT	Number of characters remaining before decimal point
;DECEXP	Exponent (Decimal)
;CHRCNT	Total number of characters remaining
;
	JSP 0,FLONRM		;SET UP AC'S AND NORMALIZE FOR BASE 10
	.PLEVEL←←.PLEVEL+3
	CAMG CHRCNT,DECEXP	;WILL IT FIT?
	GO ELOST		;LOSES!
	SKIPL DECEXP		;IF EXP≥0
	SUB DECPT,DECEXP	;  THEN SUBTRACT SPACE FOR FIXED PART + DEC. PT
	HLRZ 1,CONTRL		;FETCH NUMBER OF DIGITS RIGHT OF DEC. PT.
	CAILE DECPT,1(1)	;IS THERE MORE ROOM THAN SPECIFIED?
	MOVEI DECPT,1(1)	;YES, USE SPECIFIED DECIMAL POINT
	SUBM CHRCNT,DECPT	;SUBTRACT CHARACTER RIGHT OF DEC. PT. FROM CHAR. COUNT
	CALL FLOUT		;TO GET COUNT LEFT OF DEC. PT. AND CALL OUTPUT ROUTINE
	GO FLORET

;____________________________________________________________________
;+X.XXXE+YY
↑WRFFLO↑:JSP 0,FLONRM		;SET UP AC'S AND NORMALIZE FOR BASE 10
	CALL FLONRM		;MAKE A DECIMAL EXPONENT AND NORMALIZE
ELOST:	SKIPL NUMBER
	GO [ MOVEI 1,"+"	;'+' FOR 'F' FORMAT
	     XCT OPCODE
	     SOJA CHRCNT,.+1 ]
	SUBI CHRCNT,4		;SUBTRACT SPACE FOR EXPONENT
	JUMPLE CHRCNT,FLOST	;LOSE CASE
	PUSHP DECEXP
	MOVEI DECPT,1
	MOVEI DECEXP,1
	CALL FLOUT		;OUTPUT MANTISSA
	POPP DECEXP
	MOVEI 1,"E"
	XCT OPCODE
	JUMPL DECEXP,[MOVN DECEXP,DECEXP	;OUTPUT EXPONENT
		      MOVEI 1,"-"
		      GO .+2]
	MOVEI 1,"+"
	XCT OPCODE
	IDIVI DECEXP,=10
	MOVEI 1,"0"(DECEXP)
	XCT OPCODE
	MOVEI 1,"0"(DECEXP+1)
	XCT OPCODE
	GO FLORET

FLOST:	ADDI CHRCNT,4
	MOVEI 1,"*"
FLOST1:	SOJLE CHRCNT,FLORET
	XCT OPCODE
	GO FLOST1

	.PLEVEL←←.PLEVEL-3
;____________________________________________________________________
;NSUBR WRFLO,NUMBER,OPERATION
↑WRFLO↑:PUSH P,(P)		;COPY RETURN ADDRESS
	MOVE 0,-2(P)		;REPLACE ORIGINAL WITH OPERATION
	MOVEM 0,OPERATION
	MOVEI 0,1+7+1+4		;(SIGN+MANTISSA+DEC.PT.+EXPONENT)
	MOVEM 0,CONTRL
	JSP 0,FLONRM		;SET UP AC'S AND NORMALIZE FOR BASE 10
	CAMLE DECEXP,[-4]
	CAIL DECEXP,7
	GO ELOST
	JUMPE 0,[MOVEI 1,"0"
		 XCT OPCODE
		 GO FLORET]
	PUSH P,[WRFLO2]		;FAKE RETURN ADDRESS!
	ADDI DECEXP,1		;MAKES LIFE EASIER
	MOVEI DECPT,7		;SO THAT DECIMAL POINT IS NOT PRINTED IF NO
				;FRACTIONAL PART!
WRFLO3:	JUMPG DECEXP,WRFLO4
	MOVEI 1,"0"
	XCT OPCODE
	MOVEI 1,"."
	XCT OPCODE
	MOVEI 1,"0"
	AOJLE DECEXP,.-2
	SUBI DECEXP,1		;SIGH...
WRFLO4:	IDIVI 0,=10
	SUBI DECPT,1
	JUMPE 1,WRFLO4
	GO .+2
WRFLO1:	IDIVI 0,=10		;CLASSIC RECURSIVE DECIMAL PRINTER
	HRLM 1,(P)		;(LEFT HALF OF RETURN ADDRESS)
	JUMPE 0,.+2
	CALL WRFLO1
	HLRZ 1,(P)		;FETCH CHARACTER FROM LEFT HALF OF RETURN ADDRESS
	ADDI 1,"0"		;CONVERT TO DECIMAL FOR OUTPUT
	XCT OPCODE
	SUBI DECPT,1
	SOJN DECEXP,CPOPJ	;RETURN (TO NEXT CHARACTER OR DRIVER) IF CHAR. LEFT OF DEC. PT. ≠ 0.
	JUMPL DECPT,CPOPJ	;NO DECIMAL POINT IF NO FRACTIONAL PART!
	MOVEI 1,"."		;OUTPUT DECIMAL POINT
	XCT OPCODE
	POPJ P,
WRFLO2:	MOVEI 1,"0"
	SOJL DECEXP,FLORET
	XCT OPCODE
	GO .-2
;____________________________________________________________________
;   FLOATING POINT NORMALIZE (FOR BASE 10).
; 	Call with JSP 0,FLINIT
FLONRM:	PUSHP DECPT			;SAVE AC'S
	PUSHP DECEXP
	PUSHP CHRCNT
	PUSHP 0				;SAVE RETURN ADDRESS
	MOVE 0,OPERATION
	MOVEM 0,OPCODE
	MOVE 0,NUMBER			;SET UP AC WITH NUMBER TO BE PRINTED
	HRRZ CHRCNT,CONTRL		;FETCH NUMBER OF CHARACTERS FOR OUTPUT
	JUMPG 0,FLONR2			;NEGATIVE NUMBER?
	MOVNS 0				;NEGATE NUMBER
	MOVEI 1,"-"			;OUTPUT A "-"
FLONR1:	XCT OPCODE
	SUBI CHRCNT,1
FLONR2:	JUMPE 0,[SETZ DECEXP,↔POPJ P,]	;TEST FOR ZERO
	MOVEI DECEXP,6			;INIT. EXPONENT
	TLNN 0,377000			;IS IT FLOATING?
	FSC 0,233			;NO! FLOAT IT!
FLONR3:	CAML 0,[1000000.0]		;NORMALIZE
	JRST FLONR4
	FMPR 0,[10.0]
	SOJA DECEXP,FLONR3
FLONR4:	CAMGE 0,[10000000.0]
	JRST .+3
	FDVR 0,[10.0]
	AOJA DECEXP,FLONR4
	FADR 0,[0.5]		;ROUND IT (If someone wants more than 7 digits,
	FIX 0,233000		; he loses)
	HRRZ DECPT,CHRCNT	;ALSO INTO CHRCNT
	MOVEM CHRCNT,WIDTH	;(REMEMBER FOR DECIMAL POINT)
	POP0J
	.PLEVEL←←.PLEVEL-1
;____________________________________________________________________
FLORET:	POPP CHRCNT		;RESTORE AC'S
	POPP DECEXP
	POPP DECPT
	POP3J
;____________________________________________________________________
;OUTPUT FLOATING POINT NUMBER IN SPECIFIED FORMAT
FLOUT:	MOVEI 1," "		;START WITH LEADING SPACES, UNTIL DEC. PT.
	ADDI DECEXP,1		;THIS SAVES TIME LATER!
FLOUT1:	CAMG DECPT,DECEXP		;LEADING SPACES/ZEROS?
	GO FLOUT3		;NO, START ACTUAL INFORMATION
	SOJE DECPT,[ MOVEI 1,"0"	;IF CHARACTERS LEFT OF DEC. PT = 0, PRINT "0."
		 XCT OPCODE
		 SOJLE CHRCNT,CPOPJ	;CHECK IF DONE WITH FIELD
		 MOVEI 1,"."
		 XCT OPCODE
		 MOVEI 1,"0"	;USE ZEROS FROM NOW ON
		 GO FLOUT2 ]
	XCT OPCODE		;OUTPUT SPACE OR ZERO
FLOUT2:	SOJLE CHRCNT,CPOPJ		;CHECK FOR END OF FIELD
	GO FLOUT1		;REPEAT UNTIL ACTUAL INFORMATION STARTS.

;START ACTUAL INFORMATION
FLOUT3:	JUMPLE DECEXP,.+3		;IS DEC. PT. TO BE INCLUDED IN COUNT?
	CAME DECEXP,WIDTH
	SUBI CHRCNT,1		;YES, ACCOUNT FOR IT
	CAIG CHRCNT,6
	IDIV DECTAB-1(CHRCNT)
	CALL FLOUT4
	MOVEI 1,"0"
FLOUT5:	SOJL CHRCNT,CPOPJ		;TRAILING ZEROS
	XCT OPCODE
	SOJE DECPT,[MOVEI 1,"."
		CAME DECEXP,WIDTH	;SPECIAL CASE CHECK
		XCT OPCODE
		JUMPE CHRCNT,CPOPJ
		GO FLOUT5-1]
	GO FLOUT5
FLOUT4:	IDIVI 0,=10		;CLASSIC RECURSIVE DECIMAL PRINTER
	HRLM 1,(P)		;(LEFT HALF OF RETURN ADDRESS)
	SOJLE CHRCNT,.+3		;END OF FIELD CHECK
	JUMPE 0,.+2
	CALL FLOUT4
	HLRZ 1,(P)		;FETCH CHARACTER FROM LEFT HALF OF RETURN ADDRESS
	ADDI 1,"0"		;CONVERT TO DECIMAL FOR OUTPUT
	XCT OPCODE
	SOJN DECPT,CPOPJ		;RETURN (TO NEXT CHARACTER OR DRIVER) IF CHAR. LEFT OF DEC. PT. ≠ 0.
	MOVEI 1,"."		;OUTPUT DECIMAL POINT
	XCT OPCODE
CPOPJ:	POPJ P,
;____________________________________________________________________

DECTAB:	=1000000↔=100000↔=10000↔=1000↔=100↔=10

	DECLARE{OPCODE,WIDTH}
ENDR WREFLO
;Subroutines RDFILE,WRFILE
;____________________________________________________________________
SUBR RDFILE,FILBLK,OPCODE,DEFEXT
; Read a file name into FILBLK, returning terminator in AC 0 and AC 1.  Default
;    extension is used if none is given.
; Skip return if successful.  If file n   return do not alter FILBLK and non-skip
;    return
	ACCUMULATORS{P1}
	PUSHP P1
	MOVE P1,FILBLK
	CALL RDFIL1		;Read SIXBIT
	JUMPE 1,RET
	MOVEM 1,(P1)
	HLLZ 1,DEFEXT			;Fetch default extension
	MOVEM 1,1(P1)
	SETZ 1,
IFE STANSW, < GETPPN 1, >		;STANFORD alias kiudge
IFN STANSW, < DSKPPN 1, >		;Default PPN is self
	MOVEM 1,3(P1)
	CAIE 0,"."		;Extension coming?
	GO NOTEXT
	CALL RDFIL1		;Yes, read it
	HLLZM 1,1(P1)
NOTEXT:	CAIE 0,"["		;PPN coming?
	GO SKRET		;No, return
IFN STANSW, < CALL RDFIL1		;Read project
	      CALL RJUST
	      HLLM 1,3(P1) >		;(Stanford likes it PPN's right justified)
IFE STANSW, < CALL(RDINT,OPCODE,[8])	;DEC likes octal
	      HRLM 1,3(P1) >
	CAIE 0,","
	GO NOTCOM			;Assume he wants same programmer area
IFN STANSW, < CALL RDFIL1		;Read programmer
	      CALL RJUST  		;(Stanford likes it PPN's right justified)
	      HLRM 1,3(P1) >
IFE STANSW, < CALL(RDINT,OPCODE,[8])	;DEC likes octal
	      HRRM 1,3(P1) >
NOTCOM:	CAIE 0,"]"			;Don't worry if no ']'
	GO SKRET
	XCT OPCODE
	MOVE 0,1
;Skip return
SKRET:	AOS -1(P)
;Non-skip return
RET:	MOVE 1,0
	POPP P1
	POP3J

	.PLEVEL←←.PLEVEL+2	;(Set stack level for subr)
;Read sixbit with appropriate break characters
RDFIL1:	CALL(RDSIX,OPCODE,[FILBRK])
	POP0J

;Right justify for Stanford PPN
IFN STANSW,
<RJUST:	JUMPE 1,[ POP0J ]
RJUST2:	TLNE 1,77
	POP0J
	LSH 1,-6
	GO RJUST2 >
	.PLEVEL←←.PLEVEL-2

; The break table,  break on not A-Z,a-z or  $%
FILBRK:	BYTE (32) -1 (1) 0 (3) -1			;<null> thru  #
	BYTE (2) 0 (10) -1 (10) 0 (6) -1 (1) -1 (7) 0	;$ thru G
	BYTE (19) 0 (5) -1 (1) -1 (11) 0		;H thru k
	BYTE (15) 0 (5) -1 (16) 0			;l thru <bs>
ENDR RDFILE
;____________________________________________________________________
SUBR WRFILE,FILBLK,OPCODE
	ACCUMULATORS{P1,P2}
	PUSHP P1
	EXCH P2,FILBLK
	MOVSI P1,(<POINT 6,(P2)>)
LOOP1:	ILDB 1,P1
	JUMPE 1,CONT1
	ADDI 1,40
	XCT OPCODE
CONT1:	CAMN P1,[POINT 6,(P2),35]
	GO [ HLLZ 1,1(P2)
	     JUMPN 1,[	MOVEI 1,"."
			XCT OPCODE
			GO .+1 ]
	     GO EXTDON ]
	CAME P1,[POINT 6,1(P2),17]
	GO LOOP1
EXTDON:	SKIPN 3(P2)
	GO PPNDON
	MOVEI 1,"["
	XCT OPCODE
IFN STANSW,<
	MOVE P1,[POINT 6,3(P2)]
LOOP2:	ILDB 1,P1
	JUMPE 1,CONT2
	ADDI 1,40
	XCT OPCODE
CONT2:	CAMN P1,[POINT 6,3(P2),17]
	GO [ MOVEI 1,","
	     XCT OPCODE
	     GO LOOP2 ]
	CAME P1,[POINT 6,3(P2),35]
	GO LOOP2 >
IFE STANSW,<
	HLRZ 0,3(P2)
	CALL(WRINT,0,[8])
	MOVEI 1,","
	XCT OPCODE
	HRRZ 0,3(P2)
	CALL(WRINT,0,[8]) >
	MOVEI 1,"]"
	XCT OPCODE
PPNDON:	EXCH P2,FILBLK
	POPP P1
	POP2J
ENDR WRFILE
;____________________________________________________________________
END